home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 2 / Tech Arsenal 2 (Arsenal Computer).iso / clipper / s93bsp.exe / CL5 / PARTFUNC.PRG < prev    next >
Encoding:
Text File  |  1993-11-26  |  11.2 KB  |  422 lines
  1. ///////////////////////////////////////////////////////////////
  2. //
  3. //  Module : PARTFUNC.PRG
  4. //
  5. //  Created by SUMMER'93 (c) on Fri Nov 26 14:50:28 1993
  6. //
  7. ///////////////////////////////////////////////////////////////
  8. #include "snj.ch"
  9. //    Last change:  MIB   8 Nov 93    3:36 pm
  10.  
  11. procedure PARTEDIT( top, left, NROWS, MODE ) // Amended by SUMMER93
  12. // Calls: PARTPRMT PGETSPEC 
  13. // Called By: INVEDIT 
  14. //       P A R T E D I T
  15. //       Routine to process Parts Records
  16. local PARTFUNC, OLDSCR, WIDTH
  17. // do PARTEDIT with TOP, LEFT, NROWS, MODE
  18.  
  19.  
  20. save screen to OLDSCR 
  21. PARTFUNC := "PARTUPDAT" 
  22. WIDTH := 38 
  23. PARTPICS(  1 ,  replicate( "X", 24 ) )
  24. MPARTSPEC( "P"  )
  25. select PARTLINE 
  26.  
  27. MADD( ( reccount() = 0 ) )
  28. go top 
  29. do while !GETOUT() 
  30.     do PARTPRMT
  31.     dbedit( top, left, top + NROWS - 2, left + WIDTH - 1, PARTFLDS() , ;
  32.     PARTFUNC, PARTPICS() , PARTHDRS() , chr(196 ), chr(179 ), .t., "" )
  33. enddo 
  34. set color to( COLNORM() )
  35. set deleted off 
  36. replace  FIELD->PLINENO with recno( )all 
  37. set deleted on 
  38. GETOUT( .f.  )
  39. do PGETSPEC
  40. restore screen from OLDSCR 
  41. return 
  42.  
  43. //********************************************************************
  44.  
  45. function PARTUPDAT( MODE, FLD_PTR ) // Amended by SUMMER93
  46. // Calls: QBYESNO QBPROMPT PARTGET PARTPRMT 
  47. // Called By: 
  48. // The following locals have been declared by Summer'93
  49. // ADDREC CURFLD MEDSTR ACTION 
  50. local SCRBOT, RETVAL, ROWNO, COLNO, ADDREC, CURFLD, MEDSTR, ACTION
  51.  
  52. ROWNO := row( )
  53. COLNO := col( )
  54. SCRBOT := "" 
  55. ADDREC := .f. 
  56. QBKEY( lastkey( ) )
  57. RETVAL := 1 
  58.  
  59. do case 
  60.     case QBKEY()  = 27 
  61.         QBRESP( "Q"  )
  62.     case MODE  = 3 .or. MODE  = 2  // Empty, past bottom
  63.         MPLINENO( PARTLINE->PLINENO + 1  )
  64.         MADD( .t.  )
  65.         keyboard replicate( chr(19 ), FLD_PTR - 1 )
  66.         return 3 
  67.     case MODE < 4 
  68.         return 1 
  69.         //case QBKEY=-2                      && F3
  70.         //    replace PARTSPEC with "S"
  71.         //    QBRESP="I"
  72.         //case QBKEY=-3                      && F4
  73.         //    replace PARTSPEC with "P"
  74.         //    QBRESP="I"
  75.     case QBKEY()  = 13 
  76.         save screen 
  77.         CURFLD := PARTFLDS(  FLD_PTR , ) 
  78.         MEDSTR := PARTLINE->&CURFLD 
  79.         set color to( COLFLASH() )
  80.         @ ROWNO, COLNO say MEDSTR picture PARTPICS(  FLD_PTR , ) 
  81.         QBRESP( iif( QBYESNO("Edit this Field?" ) = "Y", "E", "I" ) )
  82.         set color to( COLBRIGHT() )
  83.         restore screen 
  84.     case QBKEY()  =  - 9  // F10
  85.         //    ACTION = QBPROMPT("Ignore|Edit|Add|Delete|Restore all|Parts "+chr(29)+" Specialist|Quit|","",6)
  86.         ACTION := QBPROMPT( "Ignore|Edit|Delete|Restore all|Quit|", "", 6 )
  87.     otherwise 
  88.         QBRESP( "E"  )
  89.         keyboard chr( QBKEY() )
  90. endcase 
  91.  
  92. set color to( COLBRIGHT() )
  93.  
  94. do case 
  95.         //CASE QBRESP="A"     && Add one
  96.         //    RETVAL = 3
  97.     case QBRESP()  = "D" 
  98.         save screen 
  99.         CURFLD := PARTFLDS(  FLD_PTR , ) 
  100.         MEDSTR := PARTLINE->&CURFLD 
  101.         set color to( COLFLASH() )
  102.         @ ROWNO, COLNO say MEDSTR picture PARTPICS(  FLD_PTR , ) 
  103.         if QBYESNO( "Delete this line?" ) = "Y" 
  104.             delete 
  105.         endif 
  106.         set color to( COLBRIGHT() )
  107.         restore screen 
  108.         skip 1 
  109.         skip - 1 
  110.         keyboard chr( 19 ) + chr( 24 )
  111.         RETVAL := 2 
  112.     case QBRESP()  = "E"  // Normal Selection by CR
  113.         do PARTGET with RETVAL, ROWNO, COLNO, FLD_PTR 
  114.         QBRESP( iif( GETOUT() , "Q", " " ) )
  115.         //case QBRESP="P"
  116.         //    if MPARTSPEC="P"
  117.         //        MPARTSPEC = "S"
  118.         //        do QBMESS with "Now Entering Specialist Materials",COLFLASH,5
  119.         //    else
  120.         //        MPARTSPEC = "P"
  121.         //        do QBMESS with "Now Entering Parts",COLFLASH,5
  122.         //    endif
  123.     case QBRESP()  = "R" 
  124.         if QBYESNO( "Restore all deleted lines?" ) = "Y" 
  125.             set deleted off 
  126.             recall all for deleted( )
  127.             go top 
  128.             set color to( COLBRIGHT() )
  129.             RETVAL := 2 
  130.             set deleted on 
  131.         endif 
  132.     otherwise 
  133.         GETOUT( .f.  )
  134. endcase 
  135.  
  136. if QBRESP()  = "Q" 
  137.     GETOUT( ( QBYESNO("Finished editing Parts?" ) = "Y" ) )
  138.     MADD( .f.  )
  139. endif 
  140.  
  141. if !GETOUT() 
  142.     do PARTPRMT
  143.     if FLD_PTR > 2 
  144.         SCRBOT := replicate( chr(19 ), 3 ) + iif( MADD() , chr(24 ), "" )
  145.     else 
  146.         SCRBOT := chr( 4 )
  147.     endif 
  148.     keyboard SCRBOT 
  149. endif 
  150. set color to( COLBRIGHT() )
  151.  
  152. @ 23, 1 clear to 23, 38 
  153.  
  154. return iif( GETOUT() , 0, RETVAL )
  155.  
  156. //********************************************************************
  157.  
  158. procedure PARTGET( RETVAL, ROWNO, COLNO, FLD_PTR ) // Amended by SUMMER93
  159. // Calls: PARTFILL QBREAD 
  160. // Called By: PARTUPDAT 
  161. local GETLIST
  162. // These locals cover set/get variables where lvalues are needed
  163. local MPARTDESC, MQTY, MUPRICE
  164. GETLIST := {}
  165.  
  166. PARTFILL( )
  167.  
  168. do case 
  169.     case FLD_PTR  = 1 
  170.         // GET command amended to ...
  171.         MPARTDESC := MPARTDESC()
  172.         @ ROWNO, COLNO  get MPARTDESC picture "@S24" ;
  173.          WHEN { || MPARTDESC := MPARTDESC(), .t. }  valid { || ;
  174.          MPARTDESC( MPARTDESC ) != NIL }
  175.         do QBREAD with "Enter Description", "" , GETLIST
  176.         // Call amended
  177.     case FLD_PTR  = 2 
  178.         // GET command amended to ...
  179.         MQTY := MQTY()
  180.         @ ROWNO, COLNO  get MQTY picture "99" ;
  181.          WHEN { || MQTY := MQTY(), .t. }  valid { ||  MQTY( MQTY ) != NIL }
  182.         do QBREAD with "Enter Quantity", "" , GETLIST
  183.         // Call amended
  184.     case FLD_PTR  = 3 
  185.         // GET command amended to ...
  186.         MUPRICE := MUPRICE()
  187.         @ ROWNO, COLNO  get MUPRICE picture "9999.99" ;
  188.          WHEN { || MUPRICE := MUPRICE(), .t. }  valid { || ;
  189.          MUPRICE( MUPRICE ) != NIL }
  190.         do QBREAD with "Enter Unit Price", "" , GETLIST
  191.         // Call amended
  192.     otherwise 
  193.         ?? chr( 7 )
  194. endcase 
  195.  
  196. if !GETOUT() 
  197.     if MPLINENO() > reccount( )
  198.         append blank 
  199.         replace  FIELD->INVNO with MINVNO() ,  FIELD->PLINENO with MPLINENO() ;
  200.         ,  FIELD->PARTSPEC with MPARTSPEC() 
  201.         RETVAL := 1 
  202.     endif 
  203.     do case 
  204.         case FLD_PTR  = 1 
  205.             replace  FIELD->PARTDESC with MPARTDESC() 
  206.         case FLD_PTR  = 2 
  207.             replace  FIELD->QTY with MQTY() ,  FIELD->TPRICE with ;
  208.             FIELD->UPRICE  * FIELD->QTY 
  209.         case FLD_PTR  = 3 
  210.             replace  FIELD->UPRICE with MUPRICE() ,  FIELD->TPRICE with ;
  211.             FIELD->UPRICE  * FIELD->QTY 
  212.     endcase 
  213.     if MADD() 
  214.         MADD( ( lastkey()<> 3 ) )  // PgDn
  215.     endif 
  216. else 
  217.     RETVAL := 0 
  218. endif 
  219.  
  220. return 
  221.  
  222. //********************************************************************
  223.  
  224. procedure PARTPRMT
  225. // Calls: QBCLMESS 
  226. // Called By: PARTEDIT PARTUPDAT 
  227. //       PARTPRMT
  228. local m
  229.  
  230. do QBCLMESS
  231. set color to( COLBRIGHT() )
  232. m := "Move with " + chr( 24 ) + " & " + chr( 25 ) + ;
  233. [. Scroll PgUp/PgDn. Exit: ESC. Menu: F10] 
  234. @ QBMSGLIN() , centre( m, 80 )say m 
  235. //M = "Enter Specialist Materials: F3, Parts: F4"
  236. //@ QBMSGLIN+1,centre(M,80) SAY M
  237.  
  238. set color to( COLHEAD() )
  239. @ 2, 0 say iif( MADD() , "Adding ", "Editing" )
  240. set color to( COLBRIGHT() )
  241. return 
  242.  
  243. //********************************************************************
  244.  
  245. function PARTLOAD( PINVNO ) // Amended by SUMMER93
  246. // Calls: 
  247. // Called By: INVFILL 
  248. //   P A R T L O A D
  249. local status, SELNO
  250.  
  251. status := 0 
  252.  
  253. select PARTLINE 
  254. zap 
  255.  
  256. SELNO := select( )
  257. use 
  258.  
  259. select PARTS 
  260. set softseek off 
  261. seek str( PINVNO, 5 )
  262. if found( )
  263.     copy to PARTLINE while PARTS->INVNO  = PINVNO 
  264.     status := 2 
  265. endif 
  266. select( SELNO )
  267. use PARTLINE 
  268.  
  269. return status 
  270.  
  271. //********************************************************************
  272.  
  273. procedure PARTSAVE( PINVNO ) // Amended by SUMMER93
  274. // Calls: PARTDEL PARTFILL PARTINFO QBADBLNK 
  275. // Called By: INVSAVE 
  276. local ZAPIT
  277.  
  278. set deleted off 
  279. do PARTDEL with PINVNO 
  280.  
  281. //   Copy the records across
  282. select PARTLINE 
  283. go top 
  284. do while !eof( )
  285.     PARTFILL( )
  286.     if !deleted( )
  287.         select PARTS 
  288.         go top 
  289.         if PARTINFO( )
  290.             do QBADBLNK with 50 
  291.             go top 
  292.         endif 
  293.         replace PARTS->PARTDESC with MPARTDESC() , PARTS->INVNO with MINVNO() 
  294.         replace PARTS->PARTSPEC with MPARTSPEC() , PARTS->QTY with MQTY() 
  295.         replace PARTS->UPRICE with MUPRICE() ,  FIELD->TPRICE with MTPRICE() ;
  296.         , PARTS->PLINENO with MPLINENO() 
  297.     endif 
  298.     select PARTLINE 
  299.     skip 
  300. enddo 
  301. set deleted on 
  302. MINVNO( PINVNO  )
  303.  
  304. return 
  305.  
  306. //********************************************************************
  307.  
  308. function PARTFILL
  309. // Calls: 
  310. // Called By: PARTGET PARTSAVE 
  311.  
  312. if FIELD->INVNO <> 0 
  313.     MINVNO( FIELD->INVNO  )
  314.     MPLINENO( FIELD->PLINENO  )
  315.     MPARTSPEC( FIELD->PARTSPEC  )
  316. endif 
  317. MPARTDESC( FIELD->PARTDESC  )
  318. MTPRICE( FIELD->TPRICE  )
  319. MUPRICE( FIELD->UPRICE  )
  320. MQTY( FIELD->QTY  )
  321.  
  322. return PARTINFO( )
  323.  
  324. //********************************************************************
  325.  
  326. function PARTINFO
  327. // Calls: 
  328. // Called By: PARTSAVE 
  329.  
  330. return FIELD->TPRICE > 0 .or. !empty( FIELD->PARTDESC )
  331.  
  332. //********************************************************************
  333.  
  334. function PARTCLEAR
  335. // Calls: 
  336. // Called By: BODYINIT 
  337.  
  338. MPARTDESC( space( 40 ) )
  339. MPARTSPEC( "P"  )
  340. MQTY( 0  )
  341. MTPRICE( 0  )
  342. MUPRICE( 0  )
  343. MPLINENO( 0  )
  344.  
  345. return 0 
  346. //********************************************************************
  347.  
  348. procedure PARTSHOW( top, left, NROWS ) // Amended by SUMMER93
  349. // Calls: 
  350. // Called By: INVMAIN INVEDIT INVFIND 
  351. //       P A R T S H O W
  352. //       Routine to process Parts Records
  353. local PARTFUNC, OLDSCR, WIDTH
  354. // do PARTSHOW with TOP, LEFT, NROWS, MODE
  355.  
  356.  
  357. PARTFUNC := .t. 
  358. WIDTH := 38 
  359. PARTPICS(  1 ,  replicate( "X", 15 ) )
  360.  
  361. select PARTLINE 
  362. go top 
  363. keyboard chr( 27 )
  364. set color to( COLBRIGHT() )
  365.  
  366. dbedit( top, left, top + NROWS - 2, left + WIDTH - 1, PARTFLDS() , PARTFUNC, ;
  367. PARTPICS() , PARTHDRS() , chr(196 ), chr(179 ), .t., "" )
  368.  
  369. @ 23, 1 clear to 23, 38 
  370.  
  371. set color to( COLNORM() )
  372.  
  373. return 
  374.  
  375. //********************************************************************
  376.  
  377. procedure PARTDEL( PINVNO ) // Amended by SUMMER93
  378. // Calls: QBWIPE 
  379. // Called By: INVDEL PARTSAVE 
  380.  
  381. //   Get rid of the old stuff
  382. select PARTS 
  383.  
  384. set softseek off 
  385. seek str( PINVNO, 5 )
  386. do while !eof( ).and. PARTS->INVNO  = PINVNO 
  387.     do QBWIPE
  388.     seek str( PINVNO, 5 )
  389. enddo 
  390.  
  391. return 
  392.  
  393. //**********************************************************************
  394.  
  395. procedure PGETSPEC
  396. // Calls: QBREAD 
  397. // Called By: PARTEDIT 
  398. //       Input value for Paints and Materials
  399. local GETLIST
  400. // These locals cover set/get variables where lvalues are needed
  401. local MINSSPEC, MOWNSPEC
  402. GETLIST := {}
  403. if MINSTOPAY() 
  404.     // GET command amended to ...
  405.     MINSSPEC := MINSSPEC()
  406.     @ 8, 62  get MINSSPEC picture "9999.99" ;
  407.      WHEN { || MINSSPEC := MINSSPEC(), .t. }  valid { || ;
  408.      MINSSPEC( MINSSPEC ) != NIL }
  409. else 
  410.     // GET command amended to ...
  411.     MOWNSPEC := MOWNSPEC()
  412.     @ 8, 71  get MOWNSPEC picture "9999.99" ;
  413.      WHEN { || MOWNSPEC := MOWNSPEC(), .t. }  valid { || ;
  414.      MOWNSPEC( MOWNSPEC ) != NIL }
  415. endif 
  416. do QBREAD with "Enter Paints and Materials", "" , GETLIST
  417. // Call amended
  418. GETOUT( .f.  )
  419.  
  420. return 
  421. // End of file
  422.